(define-module (grump souls dcx)
  #:use-module (grump byte-reader)
  #:use-module (ice-9 binary-ports)
  #:use-module (ice-9 match)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-1)
  #:use-module (zlib))

(define (decompress file)
  (let* ((br (byte-reader file))
         (magic (get-ascii br 0 4)))
    (cond ((string=? magic "DCP\0")
           (let ((format (get-ascii br 4 4)))
             (cond ((string=? format "DFLT")
                    (decompress-dcp-dflt br))
                   ((string=? format "EDGE")
                    (decompress-dcp-edge br))
                   (else
                    (error "Unknown format:" magic format)))))
          ((string=? magic "DCX\0")
           (let ((format (get-ascii br #x28 4)))
             (cond ((string=? format "DFLT")
                    (decompress-dcx-dflt br))
                   ((string=? format "EDGE")
                    (decompress-dcx-edge br))
                   ((string=? format "KRAK")
                    (decompress-dcx-krak br))
                   (else
                    (error "Unknown format:" magic format)))))
          (else
           (let ((b0 (get-byte br 0))
                 (b1 (get-byte br 1)))
             (if (and (= b0 #x78)
                      (member b1 '(#x01 #x5E #x9C #xDA) =))
                 (decompress-zlib br)
                 (error "Unknown format:" b0 b1)))))))

(define (decompress-dcp-dflt br) #f)
(define (decompress-dcp-edge br) #f)
(define (decompress-dcx-edge br) #f)
(define (decompress-dcx-krak br) #f)
(define (decompress-zlib br) #f)

(define (decompress-dcx-dflt br)
  (define uncompressed-size)
  (define compressed-size)
  (define compressed-header-length)

  (assert-ascii br "DCX\0")
  (assert-int32 br #x10000 #x11000)
  (assert-int32 br #x18)
  (assert-int32 br #x24)
  (assert-int32 br #x24 #x44)
  (assert-int32 br #x2C #x4C)

  (assert-ascii br "DCS\0")
  (set! uncompressed-size (read-int32 br))
  (set! compressed-size   (read-int32 br))

  (assert-ascii br "DCP\0")
  (assert-ascii br "DFLT")
  (assert-int32 br #x20)
  (assert-int32 br #x8000000 #x9000000)
  (assert-int32 br #x0)
  (assert-int32 br #x0)
  (assert-int32 br #x0)
  (assert-int32 br #x00010100)

  (assert-ascii br "DCA\0")
  (set! compressed-header-length (read-int32 br))

  (decompress-zlib br compressed-size uncompressed-size))

(define* (decompress-zlib br #:optional compressed-size uncompressed-size)
  (assert-byte br #x78)
  (assert-byte br #x01 #x5E #x9C #xDA)

  (let ((zip-data (if compressed-size
                      (read-bytes br (- compressed-size 2))
                      (read-remaining-bytes br))))

    (when compressed-size
      (let* ((remaining-bytes (read-remaining-bytes br))
             (remaining-length (and=> remaining-bytes bytevector-length)))
        (cond ((not zip-data)
               (error "Insufficient compressed data"
                      `(expected ,compressed-size)
                      `(received ,(or remaining-length 0))))
              (remaining-length
               (error "Unexpected trailing data"
                      `(expected 0)
                      `(received ,remaining-length))))))

    (let* ((zip-port (open-bytevector-input-port zip-data))
           (raw-port (make-zlib-input-port zip-port #:format 'deflate))
           (raw-data (get-bytevector-all raw-port)))

      (close-port raw-port)
      (close-port zip-port)

      (when uncompressed-size
        (unless (= uncompressed-size (bytevector-length raw-data))
          (error "Incorrect uncompressed data length"
                 `(expected ,uncompressed-size)
                 `(received ,(bytevector-length raw-data)))))

      raw-data)))
